perm filename TRFAI.FAI[MSS,LCS] blob
sn#264026 filedate 1977-02-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE TRFAI
C00011 ENDMK
C⊗;
TITLE TRFAI
INTERNAL LOOKX,LOOK,LOOKF
ENTRY CODEN,RLOOP
ENTRY SLRV,IFIX,FLOAT,EXCH
EXTERNAL AMOD,PX,Q
INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
CH←12
CH2←11
BLKS←←=1
DEFINE ERROR (MSG)
< JSA 16,.ERROR
JUMP [ASCIZ/MSG/
]
>
REGS: BLOCK 20
;CALL PUTEXT(<FILE>,<EXT>)
PUTEXT: 0 ;USES EXTOUT,FINEXT, CH2
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIL
SETZM DIR+2
SETZM DIR+3
ENTER CH2,DIR
ERROR <ENTER FAILED>
JRA 16,2(16)
DIR: BLOCK 4
;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
EXTOUT: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
OUTPUT CH2,COM
STATZ CH2,740000
ERROR <WRITE ERROR>
JRA 16,2(16)
INTFIL: 0 ;INITS DSK
MOVEI REGS
BLT REGS+3
INIT CH2,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
INTF8: MOVE 0,FILNAM#
MOVEM 0,FN#
MOVE 1,[POINT 7,FN]
INTF7: MOVE 2,[POINT 6,DIR]
SETZM DIR
MOVEI 3,5
INTF5: ILDB 0,1
CAIN 0," "
JRST INTF6
SUBI 0,40
IDPB 0,2
SOJG 3,INTF5
INTF6: HRLZI REGS
BLT 3
MOVE 0,EXTNAM#
MOVEM 0,EX#
MOVE 1,[POINT 7,EX]
MOVE 2,[POINT 6,DIR+1]
SETZM DIR+1
MOVEI 3,5
EXTF1: ILDB 0,1
CAIN 0," "
JRST EXTF2
SUBI 0,40
IDPB 0,2
SOJG 3,EXTF1
EXTF2: HRLZI REGS
BLT 3
JRA 16,0(16)
COM: OCT 0,0
COM1: 0
BLKNUM: 0
;CALL FINEXT
FINEXT: 0
CLOSE CH2,0
STATZ CH2,740000
ERROR <ERROR AFTER CLOSE>
RELEASE CH2,0
JRA 16,0(16)
;CALL GETEXT(<FILE>,<EXT>)
GETEXT: 0
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIZ
SETZM DIR+3
SETZM DIR+2
LOOKUP CH,DIR
ERROR <LOOKUP FAILED>
JRA 16,2(16)
INTFIZ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
JRST INTF8
;CALL FASTI2(<ARRAY>,<NO. WORDS>)
EXTIN: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
INPUT CH,COM
STATZ CH,740000
0
JRA 16,2(16)
DEFINE ERROR (MSG)
< JSA 16,.ERROR
JUMP [ASCIZ/MSG/
]
>
.ERROR: 0
OUTSTR [ASCIZ/?
/] ;MAKE SURE HE CAN SEE HIS ERROR
OUTSTR @(16) ;OUTPUT ERROR MESSAGE
CALLI 1,12 ;LET USER CONTI2UE
JRA 16,1(16)
CH←13
;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
LOOKF: 0
MOVSI 0,'DMD'
JRST LOOK1
LOOKX: 0
MOVE 0,@1(16)
MOVEM 0,FILNAM
JSA 16, INTFIQ
MOVE 0,DIR
JRST LOOK1
LOOK: 0
MOVEI 0,0
LOOK1: MOVEM 0,DIR+1
MOVE 0,@(16)
MOVEM 0,FILNAM
JSA 16, INTFIQ
SETZM DIR+2
SETZM DIR+3
LOOKUP CH,DIR
TDZA 0,0
MOVNI 0,1
JRA 16,1(16)
INTFIQ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH,17
SIXBIT/DSK/
0
HALT .-3
; ERROR <CAN'T INIT DSK!>
INTF4: MOVE 0,FILNAM#
MOVEM 0,FN#
MOVE 1,[POINT 7,FN]
INTF3: MOVE 2,[POINT 6,DIR]
SETZM DIR
MOVEI 3,5
INTF1: ILDB 0,1
CAIN 0," "
JRST INTF2
SUBI 0,40
IDPB 0,2
SOJG 3,INTF1
INTF2: HRLZI REGS
BLT 3
JRA 16,0(16)
RLOOP: 0 ;CALL RLOOP(A,B,K)
HRLI 1,@1(16) ;DIMENSION A(1),B(1) -- SOURCE
HRRI 1,@(16) ;DO 1 J=1,K -- DESTINATION
MOVE 2,(16) ;1 A(J)=B(J) -- WORD COUNT
ADD 2,@2(16) ;LOC OF ARRAY A + WDCNT.
BLT 1,-1(2)
JRA 16,3(16)
IFIX: 0
KIFIX 0,@(16)
JRA 16,1(16)
FLOAT: 0
FLTR 0,@(16)
JRA 16,1(16)
EXCH: 0
MOVE @(16)
EXCH @1(16)
MOVEM @(16)
JRA 16,2(16)
SLRV: 0 ; CALL SLRV(KK,C)
MOVE 1,@(16) ; KK
MOVE 2,@1(16) ; C
FADRM 2,Q+3(1) ; WORKS WITH Q ARRAY ONLY******
FADRM 2,Q+4(1) ; FOR Q(KK+4) AND (KK+5)
MOVNS Q+6(1) ; Q(KK+7)
JRA 16,2(16)
CODEN: 0 ;FUNCTION CODEN(K,N,R,M)
MOVE 1,@1(16) ;PNTR TO K ARRAY
SOJ 1,
ADD 1,(16) ;ADD LOC OF K ARRAY
MOVE 1,(1) ;GET PNTR TO R ARRAY
MOVEM 1,@3(16) ;SEND IT BACK IN M
ADD 1,2(16) ;ADD LOC OF R ARRAY
MOVE (1) ;R(M+1) (CODE NUM OF ITEM)
JRA 16,4(16)
END